地统计R实现
library(pacman)
p_load(sp,raster,rgeos,rgdal,rasterVis,raster,fs,sf,tidyverse,
spatstat,maps,maptools)
source("E:/sjdata/code/sdmenm.R")
setwd("D:/xh2/")
sa <- read.csv("./f1_points/xh/xh_sa.csv")[,2:3]
oc <- read.csv("./f1_points/xh/xh_oc.csv")[,2:3]
na <- read.csv("./f1_points/xh/xh_na.csv")[,2:3]
as <- read.csv("./f1_points/xh/xh_as.csv")[,2:3]
az <- c("BIO10","BIO11","BIO12")
azs <- paste0("./f2_envs/" ,az,".tif")
envg<- stack(azs)
plot(oc)
source("D:/HIDATA/项目代码xmind管理/share_code/sdmenm.R")
asp <- ppp_spatstat(as)
asp.km <- rescale(asp, 1000, "km")
L <- Lest(asp.km)
plot(L, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
plot(L, . -r ~ r, main=NULL, las=1, legendargs=list(cex=0.6, xpd=TRUE, inset=c(0, 0) ))
plot(L, . -r ~ r, main=NULL, las=1)
library(spatstat)
plot(envelope(asp.km, Linhom, correction = "Ripley", verbose = T),
. - r ~ r, main = "Sigma 0.75")
lhat <- Linhom(asp.km, correction="Ripley")
plot(lhat, . -r ~ r, main=NULL, las=1,xlim = c(0, 300))
g <- pcf(asp.km)
plot(g, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
plot(g, . -r ~ r, main=NULL, las=1,xlim = c(0, 50),
legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
ass <- raster::extract(envg,as) %>% na.omit()
ass <- zero_1(ass)[,4:6]
names(ass) <- c("BIO10","BIO11","BIO12")
threeDPpp <- pp3(ass$BIO10, ass$BIO11, ass$BIO12, box3(c(0,1)))
plot3d(ass)
threeDPppKest <- K3est(threeDPpp)
plot(threeDPppKest, . -r ~ r, main=NULL, las=1)
Q <- quadratcount(asp.km, nx= 10, ny=10)
plot(asp.km, pch=20, cols="grey70", main=NULL)
plot(Q, add=TRUE)
Q.d <- intensity(Q)
plot(intensity(Q, image=TRUE), main=NULL, las=1)
plot(asp.km, pch=20, cex=0.6, col=rgb(0,0,0,.5), add=TRUE)
X<-asp.km
plot(X)
plot(density(X, 10))
contour(density(X,10), axes=FALSE)
pzbio10 <- raster_utm(as,envg$BIO10)
pzbio10 <- as.im(pzbio10)
hist(pzbio10 , main=NULL, las=1)
pzbio10.km <- rescale(pzbio10, 1000, "km")
pzbio11 <- raster_utm(as,envg$BIO11)
pzbio11 <- as.im(pzbio11)
hist(pzbio11 , main=NULL, las=1)
pzbio11.km <- rescale(pzbio11, 1000, "km")
pzbio12 <- raster_utm(as,envg$BIO12)
pzbio12 <- as.im(pzbio12) %>% log()
hist(pzbio12 , main=NULL, las=1)
pzbio12.km <- rescale(pzbio12, 1000, "km")
b <- quantile(pzbio10.km, probs = (0:4)/4) %>% round(3)
Zcut <- cut(pzbio10.km, breaks = b)
V <- tess(image = Zcut)
plot(V)
plot(asp.km, add = TRUE, pch = "+")
qb <- quadratcount(asp.km, tess = V)
plot(qb)
plot(rhohat(asp.km, pzbio10.km,method="ratio"))
bio10th0 <- rhohat(asp.km, pzbio10.km)
H <- hyperframe(points=list(asp.km,asp.km,asp.km),
Image=list(pzbio10.km,pzbio11.km,pzbio12.km)
)
rhos <- with(H, rhohat(points, Image))
sav <- raster::extract(envg,sa) %>% cbind(sa) %>% na.omit()
sa <- sav[,4:5] %>% data.frame()
sap <- ppp_spatstat(sa)
sap.km <- rescale(sap, 1000, "km")
L <- Lest(sap.km)
plot(L, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
plot(L, . -r ~ r, main=NULL, las=1, legendargs=list(cex=0.6, xpd=TRUE, inset=c(0, 0) ))
plot(L, . -r ~ r, main=NULL, las=1)
library(spatstat)
plot(envelope(sap.km, Linhom, correction = "Ripley", verbose = T),
. - r ~ r, main = "Sigma 0.75")
lhat <- Linhom(sap.km, correction="Ripley")
plot(lhat, . -r ~ r, main=NULL, las=1,xlim = c(0, 300))
plot(sap.km)
g <- pcf(sap.km)
plot(g, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
plot(g, . -r ~ r, main=NULL, las=1,xlim = c(0, 50),
legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
plot(sap.km)
az <- c("BIO10","BIO11","BIO12")
azs <- paste0("./f2_envs/" ,az,".tif")
envg<- stack(azs)
ass <- raster::extract(envg,sa) %>% na.omit()
ass <- zero_1(ass)[,4:6]
names(ass) <- c("BIO10","BIO11","BIO12")
threeDPpp <- pp3(ass$BIO10, ass$BIO11, ass$BIO12, box3(c(0,1)))
plot3d(ass)
threeDPppKest <- K3est(threeDPpp)
plot(threeDPppKest, . -r ~ r, main=NULL, las=1)
Q <- quadratcount(sap.km, nx= 10, ny=10)
plot(sap.km, pch=20, cols="grey70", main=NULL)
plot(Q, add=TRUE)
Q.d <- intensity(Q)
plot(intensity(Q, image=TRUE), main=NULL, las=1)
plot(sap.km, pch=20, cex=0.6, col=rgb(0,0,0,.5), add=TRUE)
X<-sap.km
plot(X)
plot(density(X, 10))
contour(density(X,10), axes=FALSE)
pzbio10 <- raster_utm(sa,envg$BIO10)
pzbio10 <- as.im(pzbio10)
hist(pzbio10 , main=NULL, las=1)
pzbio10.km <- rescale(pzbio10, 1000, "km")
pzbio11 <- raster_utm(sa,envg$BIO11)
pzbio11 <- as.im(pzbio11)
hist(pzbio11 , main=NULL, las=1)
pzbio11.km <- rescale(pzbio11, 1000, "km")
plot(envg$BIO12)
pzbio12 <- raster_utm(sa,envg$BIO12)
pzbio12 <- as.im(pzbio12)
hist(pzbio12 , main=NULL, las=1)
pzbio12.km <- rescale(pzbio12, 1000, "km")
b <- quantile(pzbio10.km, probs = (0:4)/4) %>% round(3)
Zcut <- cut(pzbio10.km, breaks = b)
V <- tess(image = Zcut)
plot(V)
plot(sap.km, add = TRUE, pch = "+")
qb <- quadratcount(sap.km, tess = V)
plot(qb)
plot(rhohat(sap.km, pzbio10.km,method="ratio"))
bio10th0 <- rhohat(sap.km, pzbio12.km)
H <- hyperframe(points=list(sap.km,sap.km,sap.km),
Image=list(pzbio10.km,pzbio11.km,pzbio12.km)
)
rhos <- with(H, rhohat(points, Image))
plot(rhos)
ocv <- raster::extract(envg,oc) %>% cbind(oc) %>% na.omit()
oc <- ocv[,4:5] %>% data.frame()
ocp <- ppp_spatstat(oc)
ocp.km <- rescale(ocp, 1000, "km")
plot(ocp.km)
L <- Lest(ocp.km)
plot(L, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
plot(L, . -r ~ r, main=NULL, las=1, legendargs=list(cex=0.6, xpd=TRUE, inset=c(0, 0) ))
plot(L, . -r ~ r, main=NULL, las=1)
library(spatstat)
plot(envelope(ocp.km, Linhom, correction = "Ripley", verbose = T),
. - r ~ r, main = "Sigma 0.75")
lhat <- Linhom(ocp.km, correction="Ripley")
plot(lhat, . -r ~ r, main=NULL, las=1,xlim = c(0, 300))
g <- pcf(ocp.km)
plot(g, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
plot(g, . -r ~ r, main=NULL, las=1,xlim = c(0, 50),
legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
az <- c("BIO10","BIO11","BIO12")
azs <- paste0("./f2_envs/" ,az,".tif")
envg<- stack(azs)
ass <- raster::extract(envg,oc) %>% na.omit()
ass <- zero_1(ass)[,4:6]
names(ass) <- c("BIO10","BIO11","BIO12")
threeDPpp <- pp3(ass$BIO10, ass$BIO11, ass$BIO12, box3(c(0,1)))
plot(threeDPpp)
threeDPppKest <- K3est(threeDPpp)
plot(threeDPppKest, . -r ~ r, main=NULL, las=1)
plot(threeDPppKest, main=NULL, las=1)
Q <- quadratcount(ocp.km, nx= 10, ny=10)
plot(ocp.km, pch=20, cols="grey70", main=NULL)
plot(Q, add=TRUE)
Q.d <- intensity(Q)
plot(intensity(Q, image=TRUE), main=NULL, las=1)
plot(ocp.km, pch=20, cex=0.6, col=rgb(0,0,0,.5), add=TRUE)
X<-ocp.km
plot(X)
plot(density(X, 10))
contour(density(X,10), axes=FALSE)
pzbio10 <- raster_utm(oc,envg$BIO10)
pzbio10 <- as.im(pzbio10)
hist(pzbio10 , main=NULL, las=1)
pzbio10.km <- rescale(pzbio10, 1000, "km")
pzbio11 <- raster_utm(oc,envg$BIO11)
pzbio11 <- as.im(pzbio11)
hist(pzbio11 , main=NULL, las=1)
pzbio11.km <- rescale(pzbio11, 1000, "km")
pzbio12 <- raster_utm(oc,envg$BIO12)
pzbio12 <- as.im(pzbio12) %>% log()
hist(pzbio12 , main=NULL, las=1)
pzbio12.km <- rescale(pzbio12, 1000, "km")
b <- quantile(pzbio10.km, probs = (0:4)/4) %>% round(3)
Zcut <- cut(pzbio10.km, breaks = b)
V <- tess(image = Zcut)
plot(V)
plot(ocp.km, add = TRUE, pch = "+")
qb <- quadratcount(ocp.km, tess = V)
plot(qb)
plot(rhohat(ocp.km, pzbio10.km,method="ratio"))
bio10th0 <- rhohat(ocp.km, pzbio12.km)
plot(ocp.km)
H <- hyperframe(points=list(ocp.km,ocp.km,ocp.km),
Image=list(pzbio10.km,pzbio11.km,pzbio12.km)
)
rhos <- with(H, rhohat(points, Image))
plot(rhos)
plot(oc)
map(add =T)
nav <- raster::extract(envg,na) %>% cbind(na) %>% na.omit()
na <- nav[,4:5] %>% data.frame()
nap <- ppp_spatstat(na)
nap.km <- rescale(nap, 1000, "km")
L <- Lest(nap.km)
plot(L, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
plot(L, . -r ~ r, main=NULL, las=1, legendargs=list(cex=0.6, xpd=TRUE, inset=c(0, 0) ))
plot(L, . -r ~ r, main=NULL, las=1)
library(spatstat)
plot(envelope(nap.km, Linhom, correction = "Ripley", verbose = T),
. - r ~ r, main = "Sigma 0.75")
lhat <- Linhom(nap.km, correction="Ripley")
plot(lhat, . -r ~ r, main=NULL, las=1,xlim = c(0, 300))
g <- pcf(nap.km)
plot(g, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
plot(g, . -r ~ r, main=NULL, las=1,xlim = c(0, 50),
legendargs=list(cex=0.8, xpd=TRUE, inset=c(0.3, 0.1) ))
az <- c("BIO10","BIO11","BIO12")
azs <- paste0("./f2_envs/" ,az,".tif")
envg<- stack(azs)
ass <- raster::extract(envg,na) %>% na.omit()
ass <- zero_1(ass)[,4:6]
names(ass) <- c("BIO10","BIO11","BIO12")
threeDPpp <- pp3(ass$BIO10, ass$BIO11, ass$BIO12, box3(c(0,1)))
plot3d(ass)
threeDPppKest <- K3est(threeDPpp)
plot(threeDPppKest, . -r ~ r, main=NULL, las=1)
Q <- quadratcount(nap.km, nx= 10, ny=10)
plot(nap.km, pch=20, cols="grey70", main=NULL)
plot(Q, add=TRUE)
Q.d <- intensity(Q)
plot(intensity(Q, image=TRUE), main=NULL, las=1)
plot(nap.km, pch=20, cex=0.6, col=rgb(0,0,0,.5), add=TRUE)
X<-nap.km
plot(X)
plot(density(X, 10))
contour(density(X,10), axes=FALSE)
pzbio10 <- raster_utm(na,envg$BIO10)
pzbio10 <- as.im(pzbio10)
hist(pzbio10 , main=NULL, las=1)
pzbio10.km <- rescale(pzbio10, 1000, "km")
pzbio11 <- raster_utm(na,envg$BIO11)
pzbio11 <- as.im(pzbio11)
hist(pzbio11 , main=NULL, las=1)
pzbio11.km <- rescale(pzbio11, 1000, "km")
pzbio12 <- raster_utm(na,envg$BIO12)
pzbio12 <- as.im(pzbio12)
plot(pzbio12)
hist(pzbio12 , main=NULL, las=1)
pzbio12.km <- rescale(pzbio12, 1000, "km")
b <- quantile(pzbio10.km, probs = (0:4)/4) %>% round(3)
Zcut <- cut(pzbio10.km, breaks = b)
V <- tess(image = Zcut)
plot(V)
plot(nap.km, add = TRUE, pch = "+")
qb <- quadratcount(nap.km, tess = V)
plot(qb)
plot(rhohat(nap.km, pzbio10.km,method="ratio"))
bio10th0 <- rhohat(nap.km, pzbio10.km)
H <- hyperframe(points=list(nap.km,nap.km,nap.km),
Image=list(pzbio10.km,pzbio11.km,pzbio12.km)
)
rhos <- with(H, rhohat(points, Image))
plot(rhos)
asv <- raster::extract(envg,as) %>% cbind(as) %>% na.omit()
sav <- raster::extract(envg,sa) %>% cbind(sa) %>% na.omit()
ocv <- raster::extract(envg,oc) %>% cbind(oc) %>% na.omit()
nav <- raster::extract(envg,na) %>% cbind(na) %>% na.omit()
write.csv(sav,"C:/Users/admin/Desktop/sav.csv")
点统计的一般分析源码
library(spatstat)
load(url("http://github.com/mgimond/Spatial/raw/master/Data/ppa.RData"))
marks(starbucks) <- NULL
Window(starbucks) <- ma
plot(starbucks, main=NULL, cols=rgb(0,0,0,.2), pch=20)
Q <- quadratcount(starbucks, nx= 6, ny=3)
plot(starbucks, pch=20, cols="grey70", main=NULL)
plot(Q, add=TRUE)
Q.d <- intensity(Q)
plot(intensity(Q, image=TRUE), main=NULL, las=1)
plot(starbucks, pch=20, cex=0.6, col=rgb(0,0,0,.5), add=TRUE)
library(rspatial)
city <- sp_data('city')
crime <- sp_data('crime')
r <- raster(city)
res(r) <- 1000
plot(r)
quads <- as(r, 'SpatialPolygons')
plot(quads, add=TRUE)
points(crime, col='red', cex=.5)
nc <- rasterize(coordinates(crime), r, fun='count', background=0)
plot(nc)
plot(city, add=TRUE)
f <- freq(ncrimes, useNA='no')
plot(f, pch=20)
data(swedishpines)
X<-swedishpines
plot(X)
plot(density(swedishpines, 10))
contour(density(X,10), axes=FALSE)
data(bei)
slope <- bei.extra$grad
par(mfrow = c(1, 2))
plot(bei)
plot(bei)
data(bei)
Z <- bei.extra$grad
b <- quantile(Z, probs = (0:4)/4)
Zcut <- cut(Z, breaks = b, labels = 1:4)
V <- tess(image = Zcut)
plot(V)
plot(bei, add = TRUE, pch = "+")
qb <- quadratcount(bei, tess = V)
plot(qb)
plot(rhohat(bei, slope))
starbucks.km <- rescale(starbucks, 1000, "km")
ma.km <- rescale(ma, 1000, "km")
pop.km <- rescale(pop, 1000, "km")
pop.lg.km <- rescale(pop.lg, 1000, "km")
brk <- c( -Inf, 4, 6, 8 , Inf)
Zcut <- cut(pop.lg.km, breaks=brk, labels=1:4)
E <- tess(image=Zcut)
plot(E, main="", las=1)
Q <- quadratcount(starbucks.km, tess = E)
plot(intensity(Q, image=TRUE), las=1, main=NULL)
plot(starbucks.km, pch=20, cex=0.6, col=rgb(1,1,1,.5), add=TRUE)
cl <- interp.colours(c("lightyellow", "orange" ,"red"), E$n)
plot( intensity(Q, image=TRUE), las=1, col=cl, main=NULL)
plot(starbucks.km, pch=20, cex=0.6, col=rgb(0,0,0,.5), add=TRUE)
K2 <- density(starbucks.km, sigma=50)
plot(K2, main=NULL, las=1)
contour(K2, add=TRUE)
rho <- rhohat(starbucks.km, pop.lg.km, method="ratio")
plot(rho, las=1, main=NULL, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0)))
pred <- predict(rho)
cl <- interp.colours(c("lightyellow", "orange" ,"red"), 100)
plot(pred, col=cl, las=1, main=NULL, gamma = 0.25)
pred <- predict(rho)
cl <- interp.colours(c("lightyellow", "orange" ,"red"), 100)
plot(pred, col=cl, las=1, main=NULL, gamma = 0.25)
PPM1 <- ppm(starbucks.km ~ pop.lg.km)
plot(effectfun(PPM1, "pop.lg.km", se.fit=TRUE), main=NULL,
las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
PPM1
lng.ppm02 <- ppm(rcas.ppp, ~ offset(log(rpop)) + rinc + rroad, covariates = list(rpop = rpop.den, rroad = rcrroad.im, rinc = rcrinc.im))
ann.p <- mean(nndist(starbucks.km, k=1))
ANN <- apply(nndist(starbucks.km, k=1:100),2,FUN=mean)
plot(ANN ~ eval(1:100), type="b", main=NULL, las=1)
n <- 99
ann.r <- vector(length = n)
for (i in 1:n){
rand.p <- rpoint(n=starbucks.km$n, win=ma.km)
ann.r[i] <- mean(nndist(rand.p, k=1))
}
plot(rand.p, pch=16, main=NULL, cols=rgb(0,0,0,0.5))
hist(ann.r, main=NULL, las=1, breaks=40, col="bisque", xlim=range(ann.p, ann.r))
abline(v=ann.p, col="blue")
n <- 599L
ann.r <- vector(length=n)
for (i in 1:n){
rand.p <- rpoint(n=starbucks.km$n, f=pop.km)
ann.r[i] <- mean(nndist(rand.p, k=1))
}
hist(ann.r, main=NULL, las=1, breaks=40, col="bisque", xlim=range(ann.p, ann.r))
abline(v=ann.p, col="blue")
N.greater <- sum(ann.r > ann.p)
p <- min(N.greater + 1, n + 1 - N.greater) / (n +1)
p
K <- Kest(starbucks.km)
plot(K, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
L <- Lest(starbucks.km, main=NULL)
plot(L, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
plot(L, . -r ~ r, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
g <- pcf(starbucks.km)
plot(g, main=NULL, las=1, legendargs=list(cex=0.8, xpd=TRUE, inset=c(1.01, 0) ))
threeDPpp <- pp3(runif(10), runif(10), runif(10), box3(c(0,1)))
plot(threeDPpp)
threeDPppKest <- K3est(threeDPpp)
plot(threeDPppKest)
par(mfrow = c(1, 3))
plot(density(Liencres.pp, sigma = 0.5), main = "Sigma 0.5")
plot(density(Liencres.pp, sigma = 0.75), main = "Sigma 0.75")
plot(density(Liencres.pp, sigma = 1), main = "Sigma 1.0")
set.seed(324324)
(M <- quadrat.test(Liencres.pp, nx = 4, ny = 10, method = "MonteCarlo"))
plot(density(Liencres.pp), main = "Grid Counts")
plot(M, cex = 0.5, col = "white", add = T)
plot(envelope(Liencres.pp, Linhom, sigma = 0.75, correction = "Ripley", verbose = F),
. - r ~ r, main = "Sigma 0.75")
as <- read.csv("D:/xh2/f1_points/xh/xh_as.csv")[,2:3]
bio1 <- raster("D:/xh2/f2_envs/BIO1.tif")
asv <- raster::extract(bio1,as)
ass <- cbind(asv,as)%>% na.omit()
as <- ass[,2:3]
source("D:/HIDATA/项目代码xmind管理/share_code/sdmenm.R")
asutm <- point_wgs_utm(as)
range <- poly_wgs_utm(as)
plot(range)
points(asutm)
ptdist=pointDistance(asutm)
min.dist<-min(ptdist);
mean.dist<-mean(ptdist);
nb<-dnearneigh(coordinates(asutm),min.dist,mean.dist)
w2=knn2nb(knearneigh(asutm,k=6))
nb_lw<-nb2listw(w2,style="B")
plot(nb_lw,coordinates(asutm),col="red")
aa <- globalG.test(ass$asv,nb_lw,alternative="two.sided")
plot(aa)
local_g<-localG(ass$asv,nb_lw)
local_g <- as.matrix(local_g)
pval<- 2*pnorm(-abs(loac$.))
as$localg <- local_g
as$pvalue <- pval
attach(as)
head(as)
as$np[pval>0.05]=2
as$np[pval<0.05]=1
detach(as)
attach(as)
ggplot(as,aes(x = longitude,y = latitude,colour = localg))+
scale_colour_gradient(low = "blue",high = "red")+
geom_point(size = pvalue)+
scale_size_continuous(breaks = 0.05,guide = guide_legend())
ggplot(as,aes(x=longitude,y=latitude,colour=localg,shpae=np))+
geom_point(alpha=.5)+
scale_colour_gradient(low = "blue",high = "red")+
scale_size(breaks = c(1,2))